home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / magazine / d_b_a / 87_01 / makemenu.prg < prev    next >
Text File  |  1986-12-05  |  8KB  |  244 lines
  1. * Program..: MAKEMENU.PRG
  2. * Author...: Lane Coddington.
  3. * Date.....: August 18, 1986
  4. * Notice...: Copyright 1986, Lane Coddington Consulting.
  5. * Notes....: Makes a menu centered top to bottom and side to side.
  6. *            For dBASE III Plus or Clipper.
  7. * Called By: The dot prompt.
  8. *********************************************************************
  9. CLEAR
  10. CLEAR ALL
  11. SET TALK   OFF
  12. SET BELL   OFF
  13. SET SAFETY OFF
  14. SET STATUS OFF
  15.  
  16. * Change this prompt if you want.
  17. askprompt = [Please choose an option]
  18.  
  19. ******************************
  20. * Section 1.  Get the text for the menu.
  21. title = [ Make a Centered Menu ]
  22. @  1,(79 - LEN(title))/2 GET title
  23. CLEAR GETS
  24.  
  25. * Get the four letter name of the menu.
  26. prgname = SPACE(4)
  27. @ 3,25 SAY [Name of menu and program] GET prgname PICTURE [@!]
  28. READ
  29. IF LEN(TRIM(prgname)) = 0
  30.   RETURN
  31. ENDIF
  32. prgname = TRIM(prgname) + [MENU]
  33. memfile =      prgname  + [.MEM]
  34. prgfile =      prgname  + [.PRG]
  35.  
  36. * Find out if a memory file for this menu already exists.
  37. IF FILE(memfile)
  38.   RESTORE FROM &memfile ADDITIVE
  39. ELSE
  40.   * Initialize all memvars -- title and all lines.
  41.   menutitle = SPACE(55)
  42.   counter = [01]
  43.   DO WHILE counter <= [18]
  44.     menuline&counter = SPACE(60)
  45.     counter = RIGHT(STR(101 + VAL(counter),3),2)
  46.   ENDDO
  47.   menulimits = SPACE(19)
  48.   menutempla = SPACE(1)
  49.   menushape  = SPACE(1)
  50. ENDIF
  51.  
  52. * Get the title, all of the lines of the menu, READ limits,
  53. * PICTURE template, and the type of box border.
  54. CLEAR
  55. @  1, 5 SAY [Menu Title] GET menutitle
  56. counter = [01]
  57. DO WHILE counter <= [18]
  58.   @ (VAL(counter) + 2), 5 SAY [menuline&counter] GET menuline&counter
  59.   counter = RIGHT(STR(101 + VAL(counter),3),2)
  60. ENDDO
  61. @ 21, 5 SAY [                 Allowable limits for the READ];
  62.   GET menulimits PICTURE [@!]
  63. @ 22, 5 SAY [             Template for the PICTURE (9 or !)];
  64.   GET menutempla PICTURE [!]
  65. @ 23, 5 SAY [Box Border (1 = Solid, 2 = Double, 3 = Single)];
  66.   GET menushape PICTURE [9]
  67. READ
  68. @ 24, 5 SAY [Please wait. . .]
  69.  
  70. * Save all of the lines to a memory file for future editing.
  71. SAVE ALL LIKE menu* TO &memfile
  72.  
  73. ******************************
  74. * Section 2.  Calculate row and column coordinates and prepare
  75. * box borders.
  76.  
  77. * Make the title a little longer and assume it is the longest line.
  78. menutitle = [ ] + TRIM(menutitle) + [ ]
  79. maxlength = LEN(menutitle) + 3
  80.  
  81. * Go through all menu lines to find the longest line and the
  82. * total number of lines.
  83. counter = [01]
  84. DO WHILE counter <= [18]
  85.   menuline&counter = TRIM(menuline&counter)
  86.   IF LEN(menuline&counter) > maxlength
  87.     maxlength = LEN(menuline&counter)
  88.   ENDIF
  89.   IF LEN(menuline&counter) > 0
  90.     maxline = VAL(counter)
  91.   ENDIF
  92.   counter = RIGHT(STR(101 + VAL(counter),3),2)
  93. ENDDO
  94.  
  95. * See if the prompt is longer than or equal to any of the lines.
  96. IF LEN(askprompt) >= maxlength
  97.   askprompt = [ ] + askprompt
  98.   maxlength = LEN(askprompt) + 2
  99. ENDIF
  100.  
  101. * Increase the width of the box by one to leave a left margin of 1.
  102. maxlength = maxlength + 1
  103.  
  104. * Figure out the left margin, top line, and bottom line.
  105. lcolumn = INT((79 - maxlength)/2)
  106. topline = INT((24 - maxline)/2) - 3
  107. botline = topline + maxline + 5
  108.  
  109. * Pad each menu line with the appropriate number of blank spaces.
  110. counter = [01]
  111. DO WHILE VAL(counter) <= maxline
  112.   menuline&counter =;
  113.     STUFF(SPACE(maxlength),2,LEN(menuline&counter),menuline&counter)
  114.   counter = RIGHT(STR(101 + VAL(counter),3),2)
  115. ENDDO
  116.  
  117. * Figure out where to put the GET and pad the prompt
  118. * with blank spaces
  119. extraspace = maxlength - LEN(askprompt)
  120. position   = lcolumn   + LEN(askprompt) + INT(extraspace/2) + 1
  121. askprompt  = STUFF(SPACE(extraspace),INT(extraspace/2),0,askprompt)
  122.  
  123. * Prepare the box.
  124. DO CASE
  125. CASE menushape = [1]      && Solid Line.
  126.   topside    = CHR(222) + REPLICATE(CHR(223),maxlength) + CHR(221)
  127.   rightside  = CHR(221)
  128.   bottomside = CHR(222) + REPLICATE(CHR(220),maxlength) + CHR(221)
  129.   leftside   = CHR(222)
  130. CASE menushape = [2]      && Double Line.
  131.   topside    = CHR(201) + REPLICATE(CHR(205),maxlength) + CHR(187)
  132.   rightside  = CHR(186)
  133.   bottomside = CHR(200) + REPLICATE(CHR(205),maxlength) + CHR(188)
  134.   leftside   = CHR(186)
  135. OTHERWISE                 && Single Line.
  136.   topside    = CHR(218) + REPLICATE(CHR(196),maxlength) + CHR(191)
  137.   rightside  = CHR(179)
  138.   bottomside = CHR(192) + REPLICATE(CHR(196),maxlength) + CHR(217)
  139.   leftside   = CHR(179)
  140. ENDCASE
  141.  
  142. ******************************
  143. * Section 3.  Make the program.
  144. SET ALTERNATE TO &prgfile
  145.  
  146. * Put up a header, clear screen and initialize internal memvars.
  147. SET ALTERNATE ON
  148. ? [* Program..: ] + prgfile
  149. ? [* Author...: Your Name.]
  150. ? [* Date.....: ] + CMONTH(DATE()) + [ ] + STR(DAY(DATE()),2) +;
  151.            [, ] + STR(YEAR(DATE()),4)
  152. ? [* Notice...: Your Copyright or other notice.]
  153. ? [* Notes....: ]
  154. ? [* Called By: ]
  155. ? [* Local....: menutitle, botline]
  156. ? [* Incoming.: which_act,C - a memvar to hold the user's response.]
  157. ? [*            clipper,  L - a PUBLIC memvar to indicate whether]
  158. ? [*                          program is compiled.]
  159. ? [* Outgoing.: which_act $"] + TRIM(menulimits) + ["]
  160. ? [*****************************************************************]
  161. ? [PARAMETERS which_act]
  162. ? [CLEAR]
  163. ? [menutitle = "] + menutitle + ["]
  164. ? [botline   = ]  + STR(botline,2)
  165. ?
  166. SET ALTERNATE OFF
  167.  
  168. * Make the top three lines of the menu.
  169. * Center the title in reverse video.
  170. SET ALTERNATE ON
  171. ? [@ ] + STR(topline,2)     + [,] + STR(lcolumn,2) + [ SAY "] +;
  172.   topside  + ["]
  173. ? [@ ] + STR(topline + 1,2) + [,] + STR(lcolumn,2) + [ SAY "] +;
  174.   leftside + SPACE(maxlength) + rightside + ["]
  175. ? [@ ] + STR(topline + 1,2) + [,] +;
  176.   STR(lcolumn + 1 + ((maxlength - LEN(menutitle))/2),2) +;
  177.   [ GET menutitle]
  178. ? [@ ] + STR(topline + 2,2) + [,] + STR(lcolumn,2) + [ SAY "] +;
  179.   leftside + SPACE(maxlength) + rightside + ["]
  180. SET ALTERNATE OFF
  181.  
  182. * Put together each line of the menu body.
  183. counter = [01]
  184. DO WHILE VAL(counter) <= maxline
  185.   SET ALTERNATE ON
  186.   ? [@ ] + STR(topline + 2 + VAL(counter),2) + [,] + STR(lcolumn,2) +;
  187.     [ SAY "] + leftside + menuline&counter + rightside + ["]
  188.   SET ALTERNATE OFF
  189.   counter = RIGHT(STR(101 + VAL(counter),3),2)
  190. ENDDO
  191.  
  192. * Make the bottom 3 lines including the ask prompt centered.
  193. SET ALTERNATE ON
  194. ? [@ ] + STR(botline - 2,2) + [,] + STR(lcolumn,2) + [ SAY "] +;
  195.   leftside   + SPACE(maxlength)   + rightside + ["]
  196. ? [@ ] + STR(botline - 1,2) + [,] + STR(lcolumn,2) + [ SAY "] +;
  197.   leftside   + askprompt          + rightside + ["]
  198. ? [@ ] + STR(botline,2)     + [,] + STR(lcolumn,2) + [ SAY "] +;
  199.   bottomside + ["]
  200. SET ALTERNATE OFF
  201.  
  202. * Finish up with a loop to get the user's response and erase the box.
  203. SET ALTERNATE ON
  204. ? [CLEAR GETS]
  205. ?
  206. ? [* Get the user's desire.]
  207. ? [DO WHILE .T.]
  208. ? [  which_act = " "]
  209. ? [  @ ] + STR(botline - 1,2) + [,] + STR(position,2) +;
  210.   [ GET which_act PICTURE "] + menutempla + ["]
  211. ? [  READ]
  212. ? [  IF which_act $"] + TRIM(menulimits) + ["]
  213. ? [    EXIT]
  214. ? [  ENDIF]
  215. ? [  ?? CHR(7)]
  216. ? [ENDDO]
  217. ?
  218. ? [* Erase the box.]
  219. ? [IF clipper]
  220. ? [  * Erase the box one line at a time from the bottom.]
  221. ? [  DO WHILE botline >= ] + STR(topline,2)
  222. ? [    @ botline,] + STR(lcolumn,2) + [ SAY SPACE(] +;
  223.                          STR(maxlength + 2,2) + [)]
  224. ? [    botline = botline - 1]
  225. ? [  ENDDO]
  226. ? [ELSE]
  227. ? [  CLEAR]
  228. ? [ENDIF]
  229. ? [* EOF: ] + prgfile
  230. SET ALTERNATE OFF
  231. CLOSE ALTERNATE
  232.  
  233. ******************************
  234. * Section 4.  Test it five times.
  235. PUBLIC clipper
  236. test_count = 1
  237. which_act  = [ ]
  238. DO WHILE test_count <= 5
  239.   DO &prgfile WITH which_act
  240.   test_count = test_count + 1
  241. ENDDO
  242. * EOF: MAKEMENU.PRG
  243.  
  244.